Pascal Super Library/Pascal Super Library (CW International)(1997).bin/REFERENC/TPR/SOURCE.EXE/DEMOLIST.PAS

Pascal/Delphi Source File | 1992-08-07 | 6KB | 243 lines

{ DEMOLIST.PAS }
program DemoList;
{
Demonstrates the use of pointers to create a list structure, demonstrates how
list traversal is done in both forwards and backwards directions, and provides
routines to add (or insert) and delete items in the list.

You can modify these routines for use as a general purpose list manipulation
tool, by changing the ListEntry data structure to hold other types of data.

This demonstration program uses the Dos library routines FindFirst and
FindNext to read the default file subdirectory.
}
uses  Dos;

type
  { Data record to create the list structure }
  PListEntry = ^TListEntry;
  TListEntry = record
    DirInfo : SearchRec;
    Next    : PListEntry;
    Previous: PListEntry;
  end; {TListEntry}

var
  ListHead : PListEntry;
  ListTail : PListEntry;


function LowerCase (S : String ) : String;
Var
  I : Integer;
begin
  for I := 1 to length(s)  do
    if ((S[I]>='A') and (S[I]<='Z'))  then
      S[I] :=  Chr( Ord( S[I] ) + 32 );
  LowerCase := S;
end;



procedure InitDirectoryList;
{ Initialize the directory list structure.
  For convenience, the first entry contains the default volumne name C:\.
}
begin
  ListHead := New(PListEntry);
  ListHead^.Next := NIL;
  ListHead^.Previous := NIL;
  ListTail := ListHead;
  ListHead^.DirInfo.Name := 'C:\';
end; {InitDirectoryList}



function  AddEntry (     Location : PListEntry;
                     Var ListEntry : SearchRec ) : PListEntry;
Var
  NewEntry  : PListEntry;
  SavedNext : PListEntry;

begin
  NewEntry := New ( PListEntry );
  NewEntry^.DirInfo := ListEntry;

  If  Location = ListTail  Then
  {Adding an item on to the tail of the list}
  begin
    NewEntry^.Next := NIL;
    NewEntry^.Previous := ListTail;
    ListTail^.Next := NewEntry;
    ListTail := NewEntry;
  end
  else
  {inserting an item within the list}
  begin
    SavedNext := Location^.Next;
    Location^.Next := NewEntry;

    NewEntry^.Next := SavedNext;
    NewEntry^.Previous := Location;

    SavedNext^.Previous := NewEntry;

  end;{begin}

  AddEntry := NewEntry;

end;{AddEntry}



function  RemoveEntry ( Location : PListEntry;
                        HowMany  : Integer ) : PListEntry;

{ Starting at the point in the list indicated by 'Location', delete
  'HomeMany' entries from the list.
  Return:  A pointer to the first item after those that were deleted.
}

var
  CountOfItems : Integer;

  function DeleteEntry ( Location : PListEntry ) : PListEntry;
  begin
    if  Location <> NIL  then
    begin
      If  Location^.Previous <> NIL  Then
        Location^.Previous^.Next := Location^.Next;
      If  Location^.Next <> NIL  Then
        Location^.Next^.Previous := Location^.Previous;
      DeleteEntry := Location^.Next;
      If  Location = ListTail  Then
        ListTail := Location^.Previous;
      Dispose(Location);
    end
    else
      DeleteEntry := NIL;
  end;

begin {RemoveEntry}
  For  CountOfItems := 1 to HowMany Do
    Location := DeleteEntry ( Location );
  RemoveEntry := Location;
end;{RemoveEntry}


function Move_Fwd ( Location : PListEntry;
                    HowFar : Integer ) : PListEntry;
{Starting from 'location' move ahead 'HowFar' items in the list
 and return the new location
}
Var
  I : Integer;
begin
  For  I := 1 to HowFar  Do
    If  Location^.Next <> NIL  Then
      Location := Location^.Next;
  Move_Fwd := Location;
end;{Move_Fwd}


function Move_Bwd ( Location : PListEntry;
                    HowFar : Integer ) : PListEntry;
{Starting from 'location' move backwards 'HowFar' items in the list
 and return that new location
}
var
  I : Integer;
begin
  for  I := 1 to  HowFar  do
    if  Location^.Previous <> NIL  Then
      Location := Location^.Previous;
  Move_Bwd := Location;
end;{Move_Bwd}


Procedure DisplayFwdList;
Var
  TempPtr : PListEntry;

begin
  TempPtr := ListHead;
  While  TempPtr <> NIL  do
  begin
    writeln(TempPtr^.dirinfo.name);
    tempptr := TempPtr^.Next;
  end;
end;

procedure DisplayBwdList;
Var
  TempPtr : PListEntry;

begin
  TempPtr := ListTail;
  while  TempPtr <> NIL  do
  begin
    writeln (TempPtr^.dirinfo.name);
    tempptr := TempPtr^.Previous;
  end;
end;



procedure ReadDirectory
  ( StartingEntry : PListEntry );

{ Purpose:
  Reads the directory contents and inserts
  the list into the directory list beginning at 'StartingEntry'.

}
var
  ListEntry : SearchRec;  { Holds the contents of a directory entry
                           consisting of filename, size, etc }
  CurLocation : PListEntry;
  IsADirectory : Boolean;

begin
  {Call FindFirst to locate all files.  The '*.*' matches all filenames,
   In this case we want to see ALL files so we use the AnyFile mask.
   Note that for the purpose of this example program we are not doing
   error checking.  We should check the DosError variable after each
   call to FindFirst and FindNext.  Also, its possible that AddEntry
   will run of memory and return a NIL value but we aren't checking
   for that in this simplified application example.
  }

  FindFirst( '*.*', AnyFile, ListEntry );
  while  DosError = 0  do
  begin
    if  ListEntry.Name[1] <> '.'  then
      {Add all names other than those beginning with '.'.  This
       eliminates our displaying the '.' and '..' names used by DOS}
    begin
      IsADirectory := (ListEntry.Attr and Directory) = Directory;
      if  not  IsADirectory  then
        ListEntry.Name := LowerCase (ListEntry.Name);
        {We convert file names to lowercase and leave directory names
         in upper case for ease of reading the directory listing}
      StartingEntry := AddEntry ( StartingEntry, ListEntry );
    end; { begin }
    FindNext( ListEntry );
  end; { begin }
end; { ReadDirectory }

begin

  InitDirectoryList;

  ReadDirectory ( ListHead );


  DisplayFwdList;
  Readln;

  DisplayBwdList;
  Readln;

end.